home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / modula.zoo / _defn_realinou.mod < prev    next >
Text File  |  1988-04-24  |  6KB  |  176 lines
  1. IMPLEMENTATION MODULE RealInOut ;
  2.  
  3. FROM InOut IMPORT ReadString , WriteString ;
  4. FROM SYSTEM IMPORT VAL ;
  5.  
  6.  
  7. PROCEDURE exponentten( i : INTEGER ) : REAL ;
  8. VAR  x, w : REAL ;
  9.      expsign : BOOLEAN ;
  10. BEGIN
  11.      x := 10.0 ; w := 1.0 ;
  12.      IF i < 0 THEN 
  13.           expsign := TRUE ; i := - i 
  14.      ELSE  
  15.           expsign := FALSE 
  16.      END ;
  17.      WHILE i > 0 DO
  18.           IF ODD( i ) THEN w := w * x END ;
  19.           x := x * x ;
  20.           i := i DIV 2 
  21.      END ;
  22.      IF expsign THEN w :=  1.0 / w END ;
  23.      RETURN w
  24. END exponentten;
  25.  
  26. PROCEDURE RealToString(VAR S:ARRAY OF CHAR; real :REAL; N :CARDINAL ):BOOLEAN;
  27. TYPE TrickRecord =  RECORD
  28.                          CASE : CARDINAL OF
  29.                               0: r:      REAL |
  30.                               1: ch, cl: CARDINAL
  31.                          END
  32.                     END;
  33. VAR
  34.      maxlength, minsize, index, lvar : CARDINAL ;
  35.      trick : TrickRecord ;
  36.      exp2, exp10 : INTEGER ;
  37.      eps : REAL ;
  38. BEGIN
  39.      maxlength := HIGH( S ) ; index := 0 ;
  40.      IF real < 0.0  THEN 
  41.           S[index] := '-' ; INC( index ) ; 
  42.           real := - real ; minsize := 7 ;
  43.      ELSE
  44.           minsize := 6
  45.      END ; 
  46.      IF (N < minsize) OR (maxlength <= N) THEN
  47.         RETURN FALSE
  48.      END ;
  49.      N := N - minsize ;
  50.      IF real = 0.0 THEN
  51.           S[index] := '0' ; 
  52.           INC( index ) ;
  53.           S[index] := '.' ;
  54.           INC( index ) ;
  55.           FOR lvar := 1 TO N DO
  56.                S[index] := '0' ;
  57.                INC( index )    
  58.           END ;
  59.           exp10 := 0 ;
  60.      ELSE
  61.           trick.r := real ;
  62.           exp2 := VAL( INTEGER, trick.ch DIV 128 ) - 127;
  63.           IF exp2 >= 0 THEN
  64.                exp10 :=   TRUNC(FLOAT(exp2) * 0.3)
  65.           ELSE
  66.                exp10 := - TRUNC(FLOAT(-exp2) * 0.3)
  67.           END;
  68.           eps := 0.5 * exponentten( 0 - VAL( INTEGER , N ) );
  69.           WHILE real * exponentten(-exp10) + eps <  1.0 DO DEC (exp10) END;
  70.           WHILE real * exponentten(-exp10) + eps >= 10.0 DO INC (exp10) END;
  71.           real := real * exponentten(-exp10) + eps (* Rundung *);
  72.           S[index] := CHR(ORD(TRUNC( real )) + 48 ) ;
  73.           INC( index ) ;
  74.           S[index] := '.' ;
  75.           INC( index ) ;
  76.           FOR lvar := 1 TO N DO
  77.                real := real - FLOAT (TRUNC (real));
  78.                real := real * 10.0;
  79.                S[index] := CHR(ORD(TRUNC( real )) + 48) ;
  80.                INC( index )
  81.           END
  82.      END;
  83.      S[index] := 'E' ;
  84.      INC( index ) ;
  85.      IF exp10 < 0 THEN S[index] := '-' ; exp10 := -exp10 
  86.      ELSE S[index] := '+' END ;
  87.      INC( index ) ;
  88.      S[index] := CHR(ORD( exp10 DIV 10 ) + 48 ) ; 
  89.      INC( index ) ;
  90.      S[index] := CHR(ORD( exp10 MOD 10 ) + 48 ) ;
  91.      INC( index ) ;
  92.      S[index] := 0C ; 
  93.      RETURN TRUE 
  94. END RealToString;
  95.  
  96. PROCEDURE StringToReal( A : ARRAY OF CHAR ; VAR RES : REAL ) : BOOLEAN ;
  97. VAR  index : CARDINAL ;
  98.      exponent : INTEGER ;
  99.      mantisse , stelle: REAL ;
  100.      vorzeichen : BOOLEAN ;
  101.      exponentvorzeichen : BOOLEAN ;
  102. BEGIN
  103.      A[HIGH(A)] := 0C ;
  104.      index := 0 ; exponent := 0 ;
  105.      vorzeichen := FALSE ;
  106.      exponentvorzeichen := FALSE ;
  107.      WHILE A[index] = ' ' DO INC( index ) END ;
  108.      IF (A[index] = '-') OR (A[index] = '+') THEN 
  109.           vorzeichen := A[index] = '-' ; INC(index) 
  110.      END ;
  111.      WHILE A[index] = ' ' DO  INC( index ) END ;
  112.      mantisse := 0.0 ;
  113.      IF ( A[index] >= '0' ) AND ( A[index] <= '9' ) THEN
  114.           REPEAT
  115.                mantisse := mantisse * 10.0 + FLOAT(ORD( A[index] ) - 48) ;
  116.                INC( index )  
  117.           UNTIL (A[index] < '0') OR (A[index] > '9') 
  118.      ELSE
  119.           RETURN FALSE 
  120.      END ;
  121.      IF A[index] ='.' THEN
  122.           INC( index ) ; 
  123.           stelle := 0.1 ;
  124.           WHILE (A[index] >= '0') AND (A[index] <= '9') DO
  125.                mantisse := mantisse + FLOAT(ORD( A[index] ) - 48) * stelle ;
  126.                stelle := stelle * 1.0E-1 ;
  127.                INC( index ) 
  128.           END
  129.      END ;         
  130.      IF A[index] = 'E' THEN
  131.           INC( index ) ;
  132.           IF (A[index] = '-') OR (A[index] = '+') THEN 
  133.                exponentvorzeichen := A[index] = '-' ; 
  134.                INC( index ) 
  135.           END ;
  136.           IF ( A[index] >= '0' ) AND ( A[index] <= '9' ) THEN
  137.                REPEAT
  138.                     exponent := exponent * 10 + ORD(A[index]) - 48 ;
  139.                     INC( index )  
  140.                UNTIL (A[index] < '0') OR (A[index] > '9') 
  141.           ELSE
  142.                RETURN FALSE 
  143.           END 
  144.      END ;
  145.      IF vorzeichen THEN mantisse := - mantisse END ;
  146.      IF exponentvorzeichen THEN exponent := - exponent END ;
  147.      RES := mantisse * exponentten( exponent ) ;
  148.      RETURN (( A[index] = 0C ) OR ( A[index] = ' ' ) OR ( A[index] = 13C )) 
  149. END StringToReal ;
  150.     
  151. PROCEDURE ReadReal( VAR real : REAL ) ;
  152. VAR  InputString : ARRAY [0..60] OF CHAR ;
  153.      TmpReal : REAL ;
  154. BEGIN
  155.      ReadString( InputString ) ;
  156.      Done := StringToReal( InputString , TmpReal ) ;
  157.      IF Done THEN real := TmpReal 
  158.      ELSE real := 0.0 
  159.      END 
  160. END ReadReal ;
  161.  
  162. PROCEDURE WriteReal( real : REAL ; n : CARDINAL ) ;
  163. VAR  OutputString : ARRAY [0..60] OF CHAR ;
  164. BEGIN
  165.      Done := RealToString( OutputString , real , n ) ; 
  166.      IF Done THEN  WriteString( OutputString ) 
  167.      ELSE WriteString( "Error in RealOutput ! " ) 
  168.      END
  169. END WriteReal ;
  170.  
  171. END RealInOut .
  172.  
  173.  
  174.  
  175.  
  176.